home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / TVFM.ZIP / ASSOC.PAS next >
Pascal/Delphi Source File  |  1992-11-03  |  11KB  |  434 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. {$V-}
  9.  
  10. unit Assoc;  { Association list manager }
  11.  
  12. interface
  13.  
  14. uses Objects, Dos;
  15.  
  16. type
  17.   PAssociation = ^TAssociation;
  18.   TAssociation = object(TObject)
  19.     Ext: ExtStr;
  20.     Cmd: PString;
  21.     Prompt: Boolean;
  22.     constructor Init(AExt: ExtStr; const ACmd: String; APrompt: Boolean);
  23.     constructor Load(var S: TStream);
  24.     destructor Done; virtual;
  25.     procedure Store(var S: TStream);
  26.   end;
  27.  
  28. procedure InitAssociations;
  29. procedure DoneAssociations;
  30.  
  31. procedure Associate(DefExt: ExtStr);
  32. function GetAssociatedCommand(Ext: ExtStr): PAssociation;
  33. procedure WriteAssociationList(var S: TStream);
  34. procedure ReadAssociationList(var S: TStream);
  35.  
  36. procedure RegisterAssociations;
  37.  
  38. implementation
  39.  
  40. uses Drivers, Views, Dialogs, App, MsgBox, Validate, Tools;
  41.  
  42. const
  43.   cmAddAssoc   = 100;
  44.   cmEditAssoc  = cmAddAssoc + 1;
  45.   cmDelAssoc   = cmEditAssoc + 1;
  46.  
  47. type
  48.   { transfer record for a list box }
  49.   TListBoxRec = record
  50.     List: PCollection;
  51.     Selection: Word;
  52.   end;
  53.  
  54.   TAssocRec = record
  55.     Extension: ExtStr;
  56.     Command: String;
  57.     Prompt: Word;
  58.   end;
  59.  
  60.   PAssociateList = ^TAssociateList;
  61.   TAssociateList = object(TCollection)
  62.     procedure FillCloneList(P: PCollection);
  63.     procedure UseCloneList(P: PCollection);
  64.   end;
  65.  
  66.   PAssocBox = ^TAssocBox;
  67.   TAssocBox = object(TListBox)
  68.     function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  69.   end;
  70.  
  71.   PAssocDialog = ^TAssocDialog;
  72.   TAssocDialog = object(TDialog)
  73.     DefExt: ExtStr;
  74.     ListBox: PAssocBox;
  75.     constructor Init(ADefExt: ExtStr);
  76.     procedure HandleEvent(var Event: TEvent); virtual;
  77.   end;
  78.  
  79.   PExtValidator = ^TExtValidator;
  80.   TExtValidator = object(TValidator)
  81.     function IsValid(const S: string): Boolean; virtual;
  82.     procedure Error; virtual;
  83.   end;
  84.  
  85.   PNonBlankValidator = ^TNonBlankValidator;
  86.   TNonBlankValidator = object(TPXPictureValidator)
  87.     procedure Error; virtual;
  88.   end;
  89.  
  90. const
  91.   RAssociation : TStreamRec = (
  92.     ObjType : 1001;
  93.     VmtLink : Ofs(TypeOf(TAssociation)^);
  94.     Load    : @TAssociation.Load;
  95.     Store   : @TAssociation.Store
  96.   );
  97.   RAssociateList : TStreamRec = (
  98.     ObjType : 1002;
  99.     VmtLink : Ofs(TypeOf(TAssociateList)^);
  100.     Load    : @TAssociateList.Load;
  101.     Store   : @TAssociateList.Store
  102.   );
  103.  
  104. const
  105.   AssociateList: PAssociateList = nil;
  106.  
  107. { TAssociateList }
  108. procedure TAssociateList.FillCloneList(P: PCollection);
  109.  
  110.   procedure AddCloneItem(Item: PAssociation); far;
  111.   begin
  112.     P^.Insert(New(PAssociation, Init(Item^.Ext, Item^.Cmd^, Item^.Prompt)));
  113.   end;
  114.  
  115. begin
  116.   ForEach(@AddCloneItem);
  117. end;
  118.  
  119. procedure TAssociateList.UseCloneList(P: PCollection);
  120.  
  121.   procedure UseCloneItem(Item: PAssociation); far;
  122.   begin
  123.     Insert(New(PAssociation, Init(Item^.Ext, Item^.Cmd^, Item^.Prompt)));
  124.   end;
  125.  
  126. begin
  127.   FreeAll;
  128.   P^.ForEach(@UseCloneItem);
  129. end;
  130.  
  131.  
  132. { TAssociation }
  133. constructor TAssociation.Init(AExt: ExtStr; const ACmd: String;
  134.   APrompt: Boolean);
  135. begin
  136.   inherited Init;
  137.   Ext := AExt;
  138.   Cmd := NewStr(ACmd);
  139.   Prompt := APrompt;
  140. end;
  141.  
  142. constructor TAssociation.Load(var S: TStream);
  143. begin
  144.   inherited Init;
  145.   S.Read(Ext, SizeOf(Ext));
  146.   Cmd := S.ReadStr;
  147.   S.Read(Prompt, SizeOf(Prompt));
  148. end;
  149.  
  150. destructor TAssociation.Done;
  151. begin
  152.   DisposeStr(Cmd);
  153.   inherited Done;
  154. end;
  155.  
  156. procedure TAssociation.Store(var S: TStream);
  157. begin
  158.   S.Write(Ext, SizeOf(Ext));
  159.   S.WriteStr(Cmd);
  160.   S.Write(Prompt, SizeOf(Prompt));
  161. end;
  162.  
  163. { TAssocBox }
  164. function TAssocBox.GetText(Item: Integer; MaxLen: Integer): String;
  165. var
  166.   T: PAssociation;
  167.   Params: array[0..1] of Longint;
  168.   S: String;
  169. begin
  170.   T := List^.At(Item);
  171.   Params[0] := Longint(@T^.Ext);
  172.   Params[1] := Longint(T^.Cmd);
  173.   FormatStr(S, '%-13s %s', Params);
  174.   if Length(S) > MaxLen then
  175.   begin
  176.     S[0] := Char(MaxLen);
  177.     { Fill the last three characters with an ellipses }
  178.     FillChar(S[MaxLen - 4], 3, '.');
  179.   end;
  180.   GetText := S;
  181. end;
  182.  
  183. function CreateEditDialog: PDialog;
  184. var
  185.   R: TRect;
  186.   D: PDialog;
  187.   P: PView;
  188. begin
  189.   R.Assign(0,0,60,9);
  190.   D := New(PDialog, Init(R, 'Edit Association'));
  191.   with D^ do
  192.   begin
  193.     Options := Options or ofCentered;
  194.     R.Assign(17,2,58,3);
  195.     P := New(PInputLine, Init(R, SizeOf(ExtStr) - 1));
  196.     Insert(P);
  197.     PInputLine(P)^.SetValidator(New(PExtValidator, Init));
  198.     P^.Options := P^.Options or ofValidate;
  199.     R.Assign(2,2,17,3);
  200.     Insert(New(PLabel, Init(R, '~E~xtension', P)));
  201.  
  202.     R.Assign(17,3,58,4);
  203.     P := New(PInputLine, Init(R, SizeOf(String) - 1));
  204.     PInputLine(P)^.SetValidator(New(PNonBlankValidator, Init('@*[@]',False)));
  205.     P^.Options := P^.Options or ofValidate;
  206.     Insert(P);
  207.  
  208.     R.Assign(2,3,17,4);
  209.     Insert(New(PLabel, Init(R, 'Co~m~mmand', P)));
  210.  
  211.     R.Assign(17,4,58,5);
  212.     Insert(New(PCheckBoxes, Init(R, NewSItem('~P~rompt for parameters',
  213.       nil))));
  214.  
  215.     R.Assign(2,6,12,8);
  216.     Insert(New(PButton, Init(R, '~O~K', cmOK, bfDefault)));
  217.     R.Move(12,0);
  218.     Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
  219.  
  220.     SelectNext(False);
  221.   end;
  222.   CreateEditDialog := D;
  223. end;
  224.  
  225. function AddAssociation(var ListBoxRec: TListBoxRec; DefExt: ExtStr): Word;
  226. var
  227.   D: PDialog;
  228.   XFer: TAssocRec;
  229.   Result: Word;
  230. begin
  231.   XFer.Extension := DefExt;
  232.   XFer.Command := '';
  233.   D := CreateEditDialog;
  234.   Result := Application^.ExecuteDialog(D, @XFer);
  235.   if Result = cmOK then with XFer do
  236.   begin
  237.     UpperCase(Extension);
  238.     ListBoxRec.List^.Insert(New(PAssociation, Init(Extension, Command,
  239.       Prompt > 0)));
  240.   end;
  241.   AddAssociation := Result;
  242. end;
  243.  
  244. function EditAssociation(var ListBoxRec: TListBoxRec): Word;
  245. var
  246.   D: PDialog;
  247.   XFer: TAssocRec;
  248.   Assoc: PAssociation;
  249.   Result: Integer;
  250. begin
  251.   Result := cmCancel;
  252.   if ListBoxRec.List^.Count = 0 then Exit;
  253.   Assoc := ListBoxRec.List^.At(ListBoxRec.Selection);
  254.   XFer.Extension := Assoc^.Ext;
  255.   XFer.Command := Assoc^.Cmd^;
  256.   if Assoc^.Prompt then XFer.Prompt := 1
  257.   else XFer.Prompt := 0;
  258.   D := CreateEditDialog;
  259.   Result := Application^.ExecuteDialog(D, @XFer);
  260.   if Result = cmOK then
  261.   begin
  262.     UpperCase(XFer.Extension);
  263.     Assoc^.Ext := XFer.Extension;
  264.     DisposeStr(Assoc^.Cmd);
  265.     Assoc^.Cmd := NewStr(XFer.Command);
  266.     Assoc^.Prompt := XFer.Prompt > 0;
  267.   end;
  268.   EditAssociation := Result;
  269. end;
  270.  
  271. function DeleteAssociation(var ListBoxRec: TListBoxRec): Word;
  272. var
  273.   Assoc: PAssociation;
  274.   Result: Integer;
  275.   P: PString;
  276. begin
  277.   Result := cmCancel;
  278.   if ListBoxRec.List^.Count = 0 then Exit;
  279.   Assoc := ListBoxRec.List^.At(ListBoxRec.Selection);
  280.   P := @Assoc^.Ext;
  281.   Result := MessageBox('Delete association for %s?', @P,
  282.     mfConfirmation + mfOKButton + mfCancelButton);
  283.   if Result = cmOK then
  284.     ListBoxRec.List^.AtFree(ListBoxRec.Selection);
  285.   DeleteAssociation := Result;
  286. end;
  287.  
  288. { TAssocDialog }
  289. constructor TAssocDialog.Init(ADefExt: ExtStr);
  290. var
  291.   R: TRect;
  292.   SB: PScrollBar;
  293. begin
  294.   R.Assign(0,0,65,15);
  295.   inherited Init(R, 'File Associations');
  296.   DefExt := ADefExt;
  297.   Options := Options or ofCentered;
  298.  
  299.   R.Assign(62,3,63,11);
  300.   SB := New(PScrollBar, Init(R));
  301.   Insert(SB);
  302.   R.Assign(2,3,62,11);
  303.   ListBox := New(PAssocBox, Init(R, 1, SB));
  304.   Insert(ListBox);
  305.   R.Assign(2,2,32,3);
  306.   Insert(New(PStaticText, Init(R, 'Extension      Command line')));
  307.  
  308.   R.Assign(2,12,12,14);
  309.   Insert(New(PButton, Init(R, '~A~dd', cmAddAssoc, bfNormal)));
  310.   R.Move(11, 0);
  311.   Insert(New(PButton, Init(R, '~E~dit', cmEditAssoc, bfNormal)));
  312.   R.Move(11, 0);
  313.   Insert(New(PButton, Init(R, '~D~elete', cmDelAssoc, bfNormal)));
  314.  
  315.   R.Move(16, 0);
  316.   Insert(New(PButton, Init(R, '~O~K', cmOK, bfDefault)));
  317.   R.Move(11, 0);
  318.   Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
  319.   SelectNext(False);
  320. end;
  321.  
  322. procedure TAssocDialog.HandleEvent(var Event: TEvent);
  323. var
  324.   ListBoxRec: TListBoxRec;
  325. begin
  326.   if ListBox^.List^.Count = 0 then
  327.     DisableCommands([cmEditAssoc,cmDelAssoc])
  328.   else
  329.     EnableCommands([cmEditAssoc,cmDelAssoc]);
  330.  
  331.   inherited HandleEvent(Event);
  332.   if Event.What = evCommand then
  333.   begin
  334.     ListBoxRec.List := ListBox^.List;
  335.     ListBoxRec.Selection := ListBox^.Focused;
  336.     case Event.Command of
  337.       cmAddAssoc :
  338.         if AddAssociation(ListBoxRec, DefExt) <> cmOK then Exit;
  339.       cmEditAssoc :
  340.         if EditAssociation(ListBoxRec) <> cmOK then Exit;
  341.       cmDelAssoc :
  342.         if DeleteAssociation(ListBoxRec) <> cmOK then Exit;
  343.     end;
  344.     ListBox^.SetRange(ListBox^.List^.Count);
  345.     ListBox^.DrawView;
  346.     ClearEvent(Event);
  347.   end;
  348. end;
  349.  
  350. { TExtValidator }
  351. function TExtValidator.IsValid(const S: string): Boolean;
  352. begin
  353.   IsValid := False;
  354.   IsValid := (Length(S) > 0) and (S[1] = '.');
  355. end;
  356.  
  357. procedure TExtValidator.Error;
  358. begin
  359.   MessageBox('Enter an valid file extension in the form ".xxx"', nil,
  360.     mfInformation + mfOKButton);
  361. end;
  362.  
  363. { TNonBlankValidator }
  364. procedure TNonBlankValidator.Error;
  365. begin
  366.   MessageBox('Field can not be blank.', nil,
  367.     mfInformation + mfOKButton);
  368. end;
  369.  
  370.  
  371. procedure InitAssociations;
  372. begin
  373.   AssociateList := New(PAssociateList, Init(10, 5));
  374. end;
  375.  
  376. procedure DoneAssociations;
  377. begin
  378.   if AssociateList <> nil then Dispose(AssociateList, Done);
  379. end;
  380.  
  381. procedure Associate(DefExt: ExtStr);
  382. var
  383.   D: PDialog;
  384.   XFer: TListBoxRec;
  385.   Result: Word;
  386. begin
  387.   if AssociateList = nil then Exit;
  388.  
  389.   XFer.List := New(PAssociateList, Init(20,5));
  390.   AssociateList^.FillCloneList(XFer.List);
  391.   XFer.Selection := 0;
  392.  
  393.   D := New(PAssocDialog, Init(DefExt));
  394.   if Application^.ExecuteDialog(D, @XFer) = cmOK then
  395.     AssociateList^.UseCloneList(XFer.List);
  396.   Dispose(XFer.List, Done);
  397. end;
  398.  
  399. function GetAssociatedCommand(Ext: ExtStr): PAssociation;
  400. var
  401.   Association: PAssociation;
  402.  
  403.   function MatchExtension(P: PAssociation): Boolean; far;
  404.   begin
  405.     MatchExtension := (P^.Ext = Ext) or ((P^.Ext = '.') and (Ext = ''));
  406.   end;
  407.  
  408. begin
  409.   GetAssociatedCommand := nil;
  410.   if AssociateList = nil then Exit;
  411.   Association := AssociateList^.FirstThat(@MatchExtension);
  412.   GetAssociatedCommand := Association;
  413. end;
  414.  
  415. procedure WriteAssociationList(var S: TStream);
  416. begin
  417.   if AssociateList = nil then Exit;
  418.   AssociateList^.Store(S);
  419. end;
  420.  
  421. procedure ReadAssociationList(var S: TStream);
  422. begin
  423.   if AssociateList <> nil then
  424.     Dispose(AssociateList, Done);
  425.   AssociateList := New(PAssociateList, Load(S));
  426. end;
  427.  
  428. procedure RegisterAssociations;
  429. begin
  430.   RegisterType(RAssociation);
  431.   RegisterType(RAssociateList);
  432. end;
  433.  
  434. end.